home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / 3D_STARS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  2.0 KB  |  68 lines
  1.  
  2. program stars; { 3d_STARS.PAS }
  3. uses u_vga,u_pal,u_3d,u_ffcel,u_kb;
  4. const
  5.   speed=2;
  6.   maxstars=300;
  7. var
  8.   points:array[1..maxstars] of record x,y,z:integer; end;
  9.  
  10. procedure init;
  11. var celpal:pal_type; celpic:pointer; i:word;
  12. begin
  13.   { setup screen - draw GFXFX2-logo in corner }
  14.   getmem(celpic,101*21);
  15.   if cel_load('gfxfx2.cel',celpic,celpal)<>cel_ok then begin
  16.     writeln('An error ocured: ',cel_errstr); halt; end;
  17.   setvideo($13);
  18.   setpal(celpal);
  19.   displaypic(319-101,199-21,celpic,101,21);
  20.   freemem(celpic,101*21);
  21.   { generate random stars }
  22.   randomize;
  23.   for i:=1 to maxstars do
  24.     repeat
  25.       points[i].x:=random(200)-100;
  26.       points[i].y:=random(200)-100;
  27.       points[i].z:=random(300)-100;
  28.     until (points[i].x<>0) and (points[i].y<>0);
  29. end;
  30.  
  31. procedure dostars;
  32. var
  33.   xp,yp:array[1..maxstars] of integer;
  34.   i:word;
  35. begin
  36.   fillchar(xp,sizeof(xp),0); { clear prev-pos-arrays at start }
  37.   fillchar(yp,sizeof(yp),0);
  38.   repeat
  39.     vretrace;
  40.     for i:=1 to maxstars do begin
  41.       { clear previous position }
  42.       if (xp[i]>=0) and (xp[i]<=319) and (yp[i]>=0) and (yp[i]<=199) then
  43.         if getpixel(xp[i],yp[i])<40 then putpixel(xp[i],yp[i],0);
  44.       { move star to viewer }
  45.       if points[i].z<(200-speed) then inc(points[i].z,speed) else begin
  46.         points[i].z:=-100; { back to far and new x and y positions }
  47.         repeat
  48.           points[i].x:=random(200)-100;
  49.           points[i].y:=random(200)-100;
  50.         until (points[i].x<>0) and (points[i].y<>0);
  51.       end;
  52.       { convert 3d position to 2d screen-coords }
  53.       conv3dto2d(xp[i],yp[i],points[i].x,points[i].y,points[i].z);
  54.       { transfer stars to mid-point of screen }
  55.       inc(xp[i],160); inc(yp[i],100);
  56.       { draw new position }
  57.       if (xp[i]>=0) and (xp[i]<=319) and (yp[i]>=0) and (yp[i]<=199) then
  58.         if getpixel(xp[i],yp[i])<40 then putpixel(xp[i],yp[i],(points[i].z+100) div 9);
  59.     end;
  60.   until keypressed;
  61. end;
  62.  
  63. begin
  64.   init;
  65.   dostars;
  66.   setvideo(u_lm);
  67. end.
  68.